home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / STRINGS / SHLNGST1 / TEST.PAS < prev   
Pascal/Delphi Source File  |  1991-02-19  |  8KB  |  253 lines
  1. program Test;
  2. {to test the ShLngStr unit}
  3.  
  4. uses
  5.   TpDos,
  6.   TpCrt,
  7.   ShLngStr;
  8.  
  9. const
  10.   Msg : array[1..11] of string[68] =
  11.     (('The routines in this unit process strings of characters up to 65517'),
  12.      (' char- acters in length. All of the string manipulation features'   ),
  13.      (' which you are used to having available for use have their analog ' ),
  14.      ('in this unit.'   +    ' Every effort has been made to keep all call'),
  15.      ('ing sequences as intuitive as pos- sible. '  +  'The test sequence '),
  16.      ('about to begin tests every function and procedure in the unit. Some'),
  17.      (' of these tests are implicit; you will not necessarily see them inv'),
  18.      ('oked in the test, but they will have been invoked at a lower level.'),
  19.      (    +  ' Please notify Madison & Associates at the address, phone nu'),
  20.      ('mber, or CIS User ID given in the documentation if you have any pro'),
  21.      ('blems or suggestions regarding ShLngStr.'                           ));
  22.  
  23. var
  24.   A,
  25.   B,
  26.   C,
  27.   D   : LongString;
  28.   E,
  29.   F,
  30.   G   : text;
  31.   W1  : word;
  32.   S1  : string;
  33.  
  34. procedure Pause;
  35.   begin
  36.     WriteLn;
  37.     Write('Any key to continue...'); if ReadKey = #0 then ;
  38.     WriteLn;
  39.     end; {Pause}
  40.  
  41. procedure DC(A : LongString; As : String; B : LongString; Bs : String);
  42.   begin
  43.     WriteLn;
  44.     case lsComp(A, B) of
  45.       LESS    : WriteLn(As + ' < ' + Bs);
  46.       EQUAL   : WriteLn(As + ' = ' + Bs);
  47.       GREATER : WriteLn(As + ' > ' + Bs);
  48.       end; {case}
  49.     end; {DC}
  50.  
  51. procedure WrapLs(C : LongString);
  52.   begin
  53.     W1 := 0;
  54.     repeat
  55.       S1 := lsGetNextStrF(C);
  56.       if W1 + Length(S1) >= 75 then begin
  57.         W1 := Length(S1);
  58.         WriteLn;
  59.         end
  60.       else
  61.         inc(W1, Length(S1)+1);
  62.       Write(S1, ' ');
  63.       until lsLength(C) = 0;
  64.     WriteLn;
  65.     end; {WrapLs}
  66.  
  67. begin
  68.   WriteLn;
  69.   lsWriteLn(Output, lsCharStrF(#205, 75));
  70.   WriteLn
  71.     ('           ShLngStr -- A LongString Processing Unit'           );
  72.   WriteLn; WriteLn
  73.     ('                             from'                             );
  74.   WriteLn; WriteLn
  75.     ('              W. G. Madison and Associates, Ltd.'              );
  76.   WriteLn; WriteLn
  77.     ('          Copyright 1991  Madison & Associates, Ltd.'          );
  78.   WriteLn
  79.     ('                     All rights reserved.'                     );
  80.   WriteLn;
  81.   assign(F, 'TEST.DAT');
  82.   Reset(F);
  83.   Assign(G, 'TEST.OUT');
  84.   Rewrite(G);
  85.   if not lsInit(A, 512) then WriteLn('Bad declaration on A');
  86.   if not lsInit(B, 600) then WriteLn('Bad declaration on B');
  87.   if not lsInit(C, 2048) then WriteLn('Bad declaration on C');
  88.   if not lsInit(D, 2048) then WriteLn('Bad declaration on D');
  89.   for W1 := 1 to 11 do
  90.     lsTransfer(lsConcatStr2LsF(D, Msg[W1]), D);
  91.   WrapLs(D);
  92.   lsWriteLn(Output, lsCharStrF(#205, 75));
  93.   Pause;
  94.   D^.Length := 0;
  95.   lsIoff;
  96.   WriteLn('Beginning File Copying Test.');
  97.   while not eof(F) do begin
  98.     lsReadLn(F, A);
  99.     if lsIoResult <> 0 then begin
  100.       WriteLn('OOPS on reading. ',W1);
  101.       Halt;
  102.       end;
  103.     lsWriteLn(G, A);
  104.     if lsIoResult <> 0 then begin
  105.       WriteLn('OOPS on writing. ',W1);
  106.       Halt;
  107.       end;
  108.     end; {while}
  109.   Close(G);
  110.   assign(E, 'COMPARE.BAT');
  111.   Rewrite(E);
  112.   WriteLn(E, 'COMP TEST.DAT TEST.OUT');
  113.   Close(E);
  114.   if ExecDos('COMPARE', true, nil) = 0 then ;
  115.   Erase(E);  {The batch file}
  116.   Erase(G);  {The output file}
  117.   lsIon;
  118.  
  119.   Reset(F);
  120.   WriteLn('Beginning RepAll, DelAll test.');
  121.   lsReadLn(F, A);
  122.   WriteLn('   The original LongString');
  123.   lsWriteLn(Output, A);
  124.   lsRepAllStr(A, 'abc', '12345', C);
  125.   lsTransfer(lsRepAllStrF(A, 'abc', '12345'), B);
  126.   WriteLn(Output, ^M^J'''abc'' replaced by ''12345''.');
  127.   lsWriteLn(Output, B);
  128.   DC(C, 'lsRepAllStr(A, ''abc'', ''12345'', C)',
  129.     B, 'lsRepAllStrF(A, ''abc'', ''12345'')');
  130.   Pause;
  131.  
  132.   lsRepAllStrUC(A, 'abc', '12345', C);
  133.   WriteLn(Output, ^M^J'Case insensitive replacement of ''abc'' by ''12345''.');
  134.   lsWriteLn(Output, C);
  135.   DC(C, 'lsRepAllStrUC(A, ''abc'', ''12345'', C)',
  136.     lsRepAllStrUCF(A, 'abc', '12345'), 'lsRepAllStrUCF(A, ''abc'', ''12345'')');
  137.   Pause;
  138.  
  139.   lsDelAllStr(A, 'abc', B);
  140.   WriteLn(Output, ^M^J'''abc'' deleted.');
  141.   lsWriteLn(Output, B);
  142.   DC(B, 'lsDelAllStr(A, ''abc'', B)', lsDelAllStrF(A, 'abc'),
  143.     'lsDelAllStrF(A, ''abc'')');
  144.   DC(B, 'lsDelAllStr(A, ''abc'', B)', lsDelAllF(A, lsStr2LongStringF('abc')),
  145.     'lsDelAllF(A, lsStr2LongStringF(''abc''))');
  146.   Pause;
  147.  
  148.   WriteLn(Output, ^M^J'Centered in a field 560 wide.');
  149.   lsCenter(A, 560, B);
  150.   lsWriteLn(Output, B);
  151.   DC(B, 'lsCenter(A, 560, B)', lsCenterF(A, 560), 'lsCenterF(A, 560)');
  152.   DC(B, 'lsCenter(A, 560, B)',
  153.          lsCenterChF(A, ' ', 560), 'lsCenterChF(A, '' '', 560)');
  154.   W1 := 560 - ((560 - lsLength(A)) shr 1);
  155.   lsPad(lsLeftPadF(A, W1), 560, C);
  156.   DC(B, 'lsCenter(A, 560, B)',
  157.      C, ^M^J' lsPad(lsLeftPadF(A, 560 - ((560 - lsLength(A)) shr 1)), 560, C)');
  158.   Pause;
  159.  
  160.   WriteLn(Output, ^M^J'Restore by trimming, padding.');
  161.   lsTrimTrail(lsTrimLeadF(B), C);
  162.   lsTrim(B, B);
  163.   lsLeftPad(B, lsLength(A), B);
  164.   lsLeftPad(C, lsLength(A), C);
  165.   lsWriteLn(Output, B);
  166.   DC(B, 'lsTrim(B, B); lsLeftPad(B, lsLength(A), B)',
  167.         lsLeftPadF(lsTrimF(B), lsLength(A)),
  168.         'lsLeftPadF(lsTrimF(B), lsLength(A))');
  169.   DC(B, 'lsTrim(B, B); lsLeftPad(B, lsLength(A), B)',
  170.      C, ^M^J' lsTrimTrail(lsTrimLeadF(B), C); lsLeftPad(C, lsLength(A), C)');
  171.   Pause;
  172.  
  173.   WriteLn(^M^J'Upcase test');
  174.   lsWriteLn(Output, lsUpcaseF(B));
  175.   lsUpcase(B, C);
  176.   DC(lsUpcaseF(B), 'lsUpcaseF(B)', C, 'lsUpcase(B, C)');
  177.   Pause;
  178.  
  179.   WriteLn(^M^J'Locase test');
  180.   lsWriteLn(Output, lsLocaseF(B));
  181.   lsLocase(B, C);
  182.   DC(lsLocaseF(B), 'lsLocaseF(B)', C, 'lsLocase(B, C)');
  183.   Pause;
  184.  
  185.   WriteLn(^M^J'Copy test');
  186.   WriteLn('Copy first upper case alphabet from the following string.');
  187.   lsWriteLn(Output, A);
  188.   lsCopy(A, lsPosStr('A', A), 26, B);
  189.   WriteLn;
  190.   lsWriteLn(Output, lsCopyF(A, lsPosStr('A', A), 26));
  191.   DC(B, 'lsCopy(A, lsPosStr(''A'', A), 26, B)',
  192.     lsCopyF(A, lsPosStr('A', A), 26),
  193.     'lsCopyF(A, lsPosStr(''A'', A), 26)');
  194.   Pause;
  195.  
  196.   WriteLn(^M^J'Insert test');
  197.   WriteLn('Insert upper case alphabet preceeding ''k'' in original LongString.');
  198.   lsWriteLn(Output, A);
  199.   WriteLn;
  200.   lsWriteLn(Output, B);
  201.   WriteLn;
  202.   lsWriteLn(Output, lsInsertStrF(A, lsLongString2Str(B), lsPosStr('k', A)));
  203.   lsInsertStr(A, lsLongString2Str(B), lsPosStr('k', A), C);
  204.   DC(C, 'lsInsertStr(A, lsLongString2Str(B), lsPosStr(''k'', A), C)',
  205.       lsInsertStrF(A, lsLongString2Str(B), lsPosStr('k', A)),
  206.       ^M^J'     lsInsertStrF(A, lsLongString2Str(B), lsPosStr(''k'', A))');
  207.   Pause;
  208.  
  209.   WriteLn(^M^J'Delete test');
  210.   WriteLn('Delete the inserted upper case alphabet from the above.');
  211.   WriteLn('   This should return the LongString to its original form.');
  212.   lsWriteLn(Output, lsDeleteF(C, lsPosStr('A', C), 26));
  213.   DC(A, 'A', lsDeleteF(C, lsPosStr('A', C), 26),
  214.             'lsDeleteF(C, lsPosStr(''A'', C), 26)');
  215.   Pause;
  216.  
  217.   {Prepare for concatenation, GetNext tests}
  218.   Reset(F);
  219.   repeat
  220.     lsReadLn(F, A);
  221.     until lsPosStrUC('WHEN', A) <> 0;
  222.   lsTransfer(A, C);
  223.   lsTransfer(A, D);
  224.   repeat
  225.     lsReadLn(F, A);
  226.     lsConcat(C, A, C);
  227.     lsTransfer(lsConcatF(D, A), D);
  228.     until eof(F);
  229.  
  230.   WriteLn(^M^J'Concatenation test');
  231.   lsWriteLn(Output, C);
  232.   DC(C, 'lsConcat(C, A, C)', D, 'lsTransfer(lsConcatF(D, A), D)');
  233.   Pause;
  234.  
  235.   WriteLn(^M^J'GetNext test, doing a word wrap on the above.');
  236.   WrapLs(C);
  237.   Close(F);
  238.  
  239.   WriteLn(^M^J'I/O Error Handling test.');
  240.   lsIoff;
  241.   Assign(E, 'FOO.BAZ');
  242.   WriteLn
  243.     ('The next line displayed should be ''104 (File not open for input)''');
  244.   lsReadLn(E, A);
  245.   WriteLn(lsIoResult,' (File not open for input)');
  246.   WriteLn
  247.     ('The next event should be a runtime error and program termination.');
  248.   lsReadLn(E, A);
  249.   lsReadLn(E, A);
  250.   lsIon;
  251.  
  252.   end.
  253.